home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Skunkware 98
/
Skunkware 98.iso
/
src
/
interp
/
tclStruct1.2.tar.gz
/
tclStruct1.2.tar
/
tclStruct1.2
/
stLookup.c
< prev
next >
Wrap
C/C++ Source or Header
|
1995-10-17
|
5KB
|
173 lines
/*
* tclStruct package
* Support 'C' structures in Tcl
*
* Written by Matthew Costello
* (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
*
* See the file "license.terms" for information on usage and
* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "stInternal.h"
STRUCT_SCCSID("@(#)tclStruct:stLookup.c 1.3 95/10/17")
/*
* Look up a type name. Because this routine is called by trace
* functions, it may not set error messages in the environment.
* Instead it will return the error message to the caller.
* Get an hash table value, by its name
*
* returns NULL if not found
*/
Struct_TypeDef *
Struct_GetHashedType(cdata,name)
ClientData cdata;
char *name;
{
Tcl_HashEntry *entryPtr;
if ((entryPtr=Tcl_FindHashEntry(Struct_TypeHash(cdata),name))!=NULL)
return (Struct_TypeDef *)Tcl_GetHashValue(entryPtr);
else
return NULL;
}
/*
* Struct_LookupType
*
* Look up a type name and returns a pointer to a type.
*
* Examples of valid types:
* int
* my_type_def_t
* int*4
* ^int
* ^int*6
*
* Result:
* Returns a pointer to the attached type.
* NULL returned and interp->result set on error.
*
* Side Effects:
* 'type' has been attached
*/
Struct_TypeDef *
Struct_LookupType(cdata, interp, typename)
ClientData cdata;
Tcl_Interp *interp;
CONST char *typename;
{
Struct_TypeDef *type;
Struct_TypeDef *basetype;
char *s, *p;
#ifdef DEBUG
if (struct_debug & (DBG_LOOKUP|DBG_PARSETYPE))
printf("Struct_LookupType( typename = \"%s\" )\n", typename );
#endif
if (cdata == NULL) {
Tcl_AppendResult(interp, "NULL package info in Struct_LookupType",NULL);
return NULL;
}
/* The 'pointer' designation has the loosest binding,
* therefore we check for it first.
*/
if (*typename == '^') {
/* Look up the base type. */
if ((basetype = Struct_LookupType(cdata,interp,typename+1)) == NULL)
return NULL;
/* Create the new pointer type. */
type = Struct_NewType(cdata,interp,NULL,sizeof(char *),
STRUCT_FLAG_USE_NULLOK|STRUCT_FLAG_NULL_OK|
STRUCT_FLAG_USE_STRICT|STRUCT_FLAG_STRICT|
STRUCT_FLAG_IS_POINTER|STRUCT_FLAG_ALIGN_SIZE,
Struct_TracePtr );
if (type == NULL) {
Struct_ReleaseType(basetype);
return NULL;
}
type->u.a.array_elem = basetype;
return type;
}
/* The array designation is the next lowest...
*/
if ((s = strrchr( typename, '*' )) != NULL) {
int nelem;
*s = '\0';
basetype = Struct_LookupType(cdata,interp,(char *)typename);
*s++ = '*';
if (basetype == NULL)
return NULL;
if (basetype->flags & STRUCT_FLAG_VARLEN) {
Tcl_AppendResult(interp, "cannot construct array from variable length type",NULL);
Struct_ReleaseType(basetype);
return NULL;
}
if (Tcl_GetInt(interp,s,&nelem) == TCL_ERROR) {
Struct_ReleaseType(basetype);
return NULL;
}
type = Struct_DefArray(cdata, interp, basetype, nelem );
Struct_ReleaseType(basetype);
#ifdef DEBUG
if (struct_debug & (DBG_LOOKUP))
printf("Struct_LookupType( typename = \"%s\" ) = %s\n",
typename, Struct_TypeName(type) );
#endif
return type;
}
/* Is this a parameterized type? */
if ( ((s = strchr( typename, '(' )) != NULL) &&
((p = strchr( s+1, ')' )) != NULL) &&
(p[1] == '\0') ) {
int nelem;
*s = '\0';
basetype = Struct_LookupType(cdata,interp,(char *)typename);
*s++ = '(';
if (basetype == NULL)
return NULL;
if (!(basetype->flags & STRUCT_FLAG_VARLEN)) {
Tcl_AppendResult(interp, "\"",typename,"\" is not a variable length type",NULL);
Struct_ReleaseType(basetype);
return NULL;
}
nelem = strtoul( s, &s, 10 );
if (s != p) {
Tcl_AppendResult(interp, "\"",typename,"\" has invalid length",NULL);
return NULL;
}
if (nelem < 0) {
Tcl_ResetResult(interp);
sprintf(interp->result,"negative array size of %d is illegal",nelem);
return NULL;
}
type = Struct_InstantiateType(cdata, interp, (char *)typename, basetype, nelem );
#ifdef DEBUG
if (struct_debug & (DBG_LOOKUP))
printf("Struct_LookupType( typename = \"%s\" ) = %s\n",
typename, Struct_TypeName(type) );
#endif
return type;
}
/* Perhaps we just have a simple type name */
if ((type = Struct_GetHashedType(cdata,(char *)typename)) != NULL) {
Struct_AttachType(type);
#ifdef DEBUG
if (struct_debug & (DBG_LOOKUP))
printf("Struct_LookupType( typename = \"%s\" ) = %s\n",
typename, Struct_TypeName(type) );
#endif
return type;
}
Tcl_AppendResult(interp, "\"",typename,"\" is not a registered type",NULL);
return NULL;
}